COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE CLRIMP
C00007 ENDMK
C⊗;
	TITLE CLRIMP

;Program to clear away hanging IMP DDBs "cleanly" by changing the state
;to Time Wait and setting a timer.  This ensures that the DDBFls routine
;will be called and release all free storage pointed to by this DDB.

A←←1 ↔ B←←2 ↔ DDB←←3 ↔ P←←17

ACWPRV←←40		;LH priv bit
PDLEN←←20
S%FIN2←←=7		;State we want to get out of
S%TIMW←←=9		;State we want to get into

;IMP DDB words, with AC field set for indirect access
DEVNAM:	0(DDB)
DEVSER:	3(DDB)
STATE:	(DDB)			;To be filled in with .SYMLed value
GTIMER:	(DDB)			;To be filled in with .SYMLed value

;Other storage
IMPDDB:	0			;Address of model IMP DDB
SYSTOP:	0			;Start of system free storage
SYSREL:	0			;Relocation for system core
DDBSAV:	0			;Address of current DDB
PDL:	BLOCK PDLEN

CLRIMP:	RESET
	MOVE P,[IOWD PDLEN,PDL]
	MOVSI A,1
	GETPRV A,		;Get passive privs
	TLNN A,ACWPRV		;Can this guy write core?
	 JRST [ OUTSTR [ASCIZ/Sorry, only wizards can run this program./]
		EXIT]
	MOVSI A,ACWPRV
	SETPRV A,		;Enable
	MOVEI A,[RADIX50 0,IMPDDB ↔ 0]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for IMPDDB./]
		EXIT]
	MOVEM A,IMPDDB
	MOVEI A,[RADIX50 0,STATE ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for STATE./]
		EXIT]
	HRRM A,STATE
	MOVEI A,[RADIX50 0,GTIMER ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for GTIMER./]
		EXIT]
	HRRM A,GTIMER
	MOVEI A,265
	PEEK A,			;Get SYSTOP
	PEEK A,
	TRZ A,1777		;Make sure it's a 1K boundary
	CAILE A,400000		;Not beyond 400000, though
	 MOVEI A,400000
	MOVEM A,SYSTOP
	MOVEI B,400000		;Compute relocation for later offsets
	SUB B,A
	MOVEM B,SYSREL
	MOVE B,A
	ADDI B,377776		;Get as much as possible, writeable
	HRL A,B
	SETPR2 A,		;Map system into upper segment
	 JRST [ OUTSTR [ASCIZ/SETPR2 lost./]
		EXIT]

	MOVE A,IMPDDB
	ADD A,DEVSER
	HRRZ A,A
	PEEK A,
	HLRZ DDB,A		;Address of first IMP DDB
LOOP:	MOVEM DDB,DDBSAV	;Save before relocating
	ADD DDB,SYSREL		;Relocate to upper segment
	HLRZ A,@DEVNAM		;Get device name
	CAIE A,'IMP'		;Is it an IMP?
	 JRST ALLDON		;No
	MOVE A,@STATE		;Get connection's TCP state
	CAIE A,S%FIN2		;In the losing state?
	 JRST NXTIMP		;No
	OUTSTR [ASCIZ/
Losing IMP DDB at /]
	MOVE A,DDBSAV
	PUSHJ P,OCTOUT		;Clobbers A and B
	OUTSTR [ASCIZ/.  Clear it? /]
	INCHRW A
	CAIE A,"Y"
	 CAIN A,"y"
	 CAIA
	 JRST NXTIMP
	MOVEI A,1		;Set timer
	MOVEM A,@GTIMER
	MOVEI A,S%TIMW		;Set new state
	MOVEM A,@STATE
NXTIMP:	HLRZ DDB,@DEVSER	;Get next DDB
	CAML DDB,SYSTOP		;Make sure it's in free storage
	 JRST LOOP
ALLDON:	EXIT

OCTOUT:	IDIVI A,10
	PUSH P,B
	JUMPE A,OCTOU1
	PUSHJ P,OCTOUT
OCTOU1:	POP P,A
	ADDI A,"0"
	OUTCHR A
	POPJ P,

	END CLRIMP